COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002		TITLE	SORT	Definitions.
C00004 00003	Storage allocations.
C00010 00004	READ FILENAMES
C00014 00005	Read in all strings in input file.
C00018 00006	Sort the strings using algorithm 5.2.2-Q in Knuth, "quicksort".
C00022 00007	Continue sorting: Q4, Q5, Q6.
C00024 00008	Continue sorting: Q7, Q8.
C00026 00009	Continue sorting: Q8B, Q8C, Q9.
C00029 00010	Write out sorted file: WRITEM.
C00033 00011	Subroutines: GETCH, PUTWD, PUTCH, ERROR, DUP, PUTDUP, NXTDG.
C00037 00012	GETFIL	NOLOOK	NOENTR	FERROR
C00041 00013	SAVSTR	RSTSTR
C00043 ENDMK
C⊗;
	TITLE	SORT	;Definitions.
AC0←←0
AC1←1
AC2←2
BEFORE←3
BPTR←←4
CHAR←←5
WD←←6
PREV←←7
PART1←4
PART2←5
PART3←6
PART4←7
PART5←10
PART6←11
PART7←12
AFTER←13
R←14
I←15
J←16
P←17

CR←←15
LF←←12
TAB←←11
FF←←14

MIN←←10			;the minimum number of elements for using quicksort

DEFINE	ERRMSG(MSG)
	{PUSHJ	P,	[MOVEM	AC1,SAVEAC
			 MOVEI	AC1,[ASCIZ \MSG\]
			 JRST	ERROR]}
;Storage allocations.

PDLEN←←=100
PDLIST:	BLOCK	PDLEN

IBUF:	BLOCK	3		;buffer header for reading in WORDS.TXT
OBUF:	BLOCK	3		;buffer header for writing out WORDS.SRT

INPPN:	0
INFILE:	BLOCK	4		;LOOKUP block

OUTPPN:	0
OUTFIL:	BLOCK	4		;ENTER block

NIBUFS←←2
BUFI:	BLOCK	203*NIBUFS

NOBUFS←←4
BUFO:	BLOCK	203*NOBUFS

repeat 0,<
;TEXT is a block for storing the characters of the strings being sorted
TLEN←←100000
TEXT:	OCT	400000000000	;a key of -∞
	BLOCK	TLEN
>

;LST is a block for keeping the (somewhat) sorted list of strings.
;	The left half of a word contains the negative of the length of the
;	text for that string.  The right half contains a ptr to its text.
LSTLEN←←=22100
LST:	XWD	-1,0-1
	BLOCK	LSTLEN

LFT:	LST+1	;address of the leftmost element of the sublist under consideration
RGT:	0	;address of the rightmost element of the sublist under consideration
LAST:	0
SAVEAC:	0			;place for saving AC1 upon detection of an error
COUNT:	0			;count of the number of words going into output file
DIGITS:	BLOCK	4		;block for holding asciz digits of a number
TEXTP:	0			;PTR TO SPACE FOR STORING TEXT OF STRINGS
TEXTP1:	0			;POINTER TO WORD BEFORE TEXT SPACE

REPEAT 0,<
SHF1:	  0↔   1↔   2↔   3↔ 103↔   5↔   6↔   7		;0
	 10↔  11↔  12↔  13↔  14↔  15↔  16↔  17		;10
	173↔ 152↔  22↔ 153↔  24↔  25↔  26↔  27		;20
	 30↔  31↔ 110↔  33↔  34↔  35↔  36↔ 111		;30
	 40↔  41↔  42↔  43↔ 172↔  45↔  46↔  47		;40
	 50↔  51↔  52↔  53↔  54↔  55↔  56↔  57		;50
	 60↔  61↔  62↔  63↔  64↔  65↔  66↔  67		;60
	 70↔  71↔  72↔  73↔  74↔  75↔  76↔  77		;70
	100↔ 101↔ 104↔ 106↔ 112↔ 114↔ 116↔ 120		;100
	122↔ 124↔ 126↔ 130↔ 132↔ 134↔ 136↔ 140		;110
	142↔ 144↔ 146↔ 150↔ 154↔ 156↔ 160↔ 162		;120
	164↔ 166↔ 170↔   4↔  20↔  21↔  23↔  32		;130
	 37↔ 102↔ 105↔ 107↔ 113↔ 115↔ 117↔ 121		;140
	123↔ 125↔ 127↔ 131↔ 133↔ 135↔ 137↔ 141		;150
	143↔ 145↔ 147↔ 151↔ 155↔ 157↔ 161↔ 163		;160
	165↔ 167↔ 171↔  44↔ 174↔ 175↔ 176↔ 177		;170

SHF2:	  0↔   1↔   2↔   3↔ 133↔   5↔   6↔   7		;0
	 10↔  11↔  12↔  13↔  14↔  15↔  16↔  17		;10
	134↔ 135↔  22↔ 136↔  24↔  25↔  26↔  27		;20
	 30↔  31↔ 137↔  33↔  34↔  35↔  36↔ 140		;30
	 40↔  41↔  42↔  43↔ 173↔  45↔  46↔  47		;40
	 50↔  51↔  52↔  53↔  54↔  55↔  56↔  57		;50
	 60↔  61↔  62↔  63↔  64↔  65↔  66↔  67		;60
	 70↔  71↔  72↔  73↔  74↔  75↔  76↔  77		;70
	100↔ 101↔ 141↔   4↔ 102↔ 142↔ 103↔ 143		;100
	 32↔  37↔ 104↔ 144↔ 105↔ 145↔ 106↔ 146		;110
	107↔ 147↔ 110↔ 150↔ 111↔ 151↔ 112↔ 152		;120
	113↔ 153↔ 114↔ 154↔ 115↔ 155↔ 116↔ 156		;130
	117↔ 157↔ 120↔ 160↔ 121↔ 161↔ 122↔ 162		;140
	123↔ 163↔  21↔  23↔ 124↔ 164↔ 125↔ 165		;150
	126↔ 166↔ 127↔ 167↔ 130↔ 170↔ 131↔ 171		;160
	132↔ 172↔  44↔  20↔ 174↔ 175↔ 176↔ 177		;170
>;END REPEAT 0

SHF1:	 17↔  17↔  41↔  42↔  41↔  17↔  43↔  42		;0
	 44↔   2↔  17↔  17↔  17↔  17↔  17↔  44		;10
	 72↔  63↔  57↔  63↔  43↔  42↔  17↔  17		;20
	 17↔  17↔  43↔  53↔  17↔  17↔  44↔  43		;30
	  4↔  43↔  17↔  17↔  72↔  17↔  17↔  17		;40
	 10↔  12↔   1↔  17↔  14↔   6↔  74↔  16		;50
	 20↔  21↔  22↔  23↔  24↔  25↔  26↔  27		;60
	 30↔  31↔  17↔  17↔  17↔  17↔  17↔  44		;70

	100↔  41↔  42↔  43↔  44↔  45↔  46↔  47		;100
	 50↔  51↔  52↔  53↔  54↔  55↔  56↔  57		;110
	 60↔  61↔  62↔  63↔  64↔  65↔  66↔  67		;120
	 70↔  71↔  72↔  17↔  17↔  17↔  17↔  43		;130
	 17↔  41↔  42↔  43↔  44↔  45↔  46↔  47		;140
	 50↔  51↔  52↔  53↔  54↔  55↔  56↔  57		;150
	 60↔  61↔  62↔  63↔  64↔  65↔  66↔  67		;160
	 70↔  71↔  72↔  17↔  17↔  17↔  17↔  17		;170

COMMENT ⊗

SORTING ORDER IS:

	*	1
	TAB	2
	SPACE	4
	DASH	6
	(	10
	)	12
	COMMA	14
	SLASH	16
	MISC.	17
	DIGITS	20:31
	LETTERS	41:72	 (α=A, β=B, ε=C, λ=D)
	PERIOD	74

⊗; END OF COMMEND
;READ FILENAMES

SORT:	OUTSTR	[ASCIZ/No SOS or ETV files please.

/]
	JRST	SORT1
REESET:	CLRBFI
	OUTSTR	[ASCIZ /
Bad filename!
/]

SORT1:	RESET
	MOVE	P,[INITP: IOWD PDLEN,PDLIST];initialize pdl ptr
	MOVE	AC1,JOBFF↑
	MOVEM	AC1,TEXTP		;POINTER TO PLACE WHERE TEXT STRS WILL GO
	SUBI	AC1,1
	MOVEM	AC1,TEXTP1		;POINTER TO PREVIOUS WORD
	ADDI	AC1,4*2000		;START WITH 4K OF WORKING TEXT SPACE
	CAMG	AC1,JOBREL↑		;ALREADY GOT PLENTY OF CORE?
	JRST	SORT2			;YES
	CORE	AC1,		;CORE UP.  MAKE SURE THERE IS ROOM TO WORK WITH
	ERRMSG	{CANT INITIALIZE CORE SIZE}
SORT2:
	MOVE	AC1,TEXTP
	SETZM	1(AC1)		;CLEAR TEXT SPACE
	HRLI	AC1,1(AC1)
	ADDI	AC1,2
	BLT	AC1,@JOBREL

	MOVSI	AC1,400000
	MOVEM	AC1,@TEXTP		;STRING OF -∞
	MOVSI	AC1,-1
	HRR	AC1,TEXTP1		;PTR TO STRING OF -∞
	MOVEM	AC1,LST
	MOVEI	AC1,LST+1
	MOVEM	AC1,LFT
	SETZM	RGT
	SETZM	LAST

;READ INPUT & OUTPUT FILENAMES
GETIN:	OUTSTR	[ASCIZ/Input file: /]
	MOVEI	R,INFILE
	PUSHJ	P,GETFIL
	JRST	REESET

	INIT	1,0
	SIXBIT	/DSK/
	IBUF
	ERRMSG	{INIT FAILED ON DSK}
	MOVE	AC1,INPPN
	MOVEM	AC1,INFILE+3
	LOOKUP	1,INFILE
	JRST	NOLOOK
	MOVEI	AC1,BUFI
	MOVEM	AC1,JOBFF↑
	INBUF	1,NIBUFS

GETOUT:	OUTSTR	[ASCIZ/Output file: /]
	MOVEI	R,OUTFIL
	PUSHJ	P,GETFIL
	JRST	REESET

	INIT	2,0
	SIXBIT	/DSK/
	XWD	OBUF,0
	ERRMSG	{INIT FAILED ON DSK}
	MOVE	AC1,OUTPPN
	MOVEM	AC1,OUTFIL+3
	LOOKUP	2,OUTFIL
	JRST	GETOU1
	OUTSTR	[ASCIZ/Output file already exists.
Type Y to REPLACE? /]
	INCHRW	AC1
	CAIN	AC1,CR
	JRST	GETOU2
	CAIE	AC1,"Y"
	CAIN	AC1,"y"
	JRST	GETOU3
	OUTSTR	[ASCIZ/

/]
	JRST	GETOUT
GETOU2:	INCHRW	AC1		;READ LF AFTER CR
	OUTSTR	[ASCIZ/
/]
	JRST	GETOUT
GETOU3:	OUTSTR	[ASCIZ/
/]
GETOU1:	CLOSE	2,		;NO RA MODE ACCESS PLEASE
	MOVE	AC1,OUTPPN
	MOVEM	AC1,OUTFIL+3
	SETZM	OUTFIL+2
	ENTER	2,OUTFIL
	JRST	NOENTR
	MOVEI	AC1,BUFO
	MOVEM	AC1,JOBFF↑
	OUTBUF	2,NOBUFS
;Read in all strings in input file.

	MOVEI	AC0,"@"
	MOVSI	BPTR,010700
	HRR	BPTR,TEXTP	;initialize byte ptr for saving text of strings
	MOVE	WD,[XWD -LSTLEN,LST+1]	;init ptr to list of strings being sorted
	OUTSTR	[ASCIZ /READING.../]
GETWD:	HRRZM	BPTR,(WD)	;save ptr to place for text of next word
	MOVE	PREV,BPTR	;save byte ptr for calculating length of word
	setzm atsign
GETLTR:	PUSHJ	P,GETCH
	cain char,"@"
	setom atsign#
	CAIN	CHAR,CR		;any char BUT CR is considered part of input word
	JRST	READLF
	IDPB	CHAR,BPTR	;save this char in TEXT
	JRST	GETLTR		;get next char

READLF:	PUSHJ	P,GETCH		;read the lf that follows the cr
	skipn atsign
	jrst noats
	outstr [asciz/String contains "@", will be truncated in output file: /]
	setzm 1(bptr)		;stop outstr
	outstr 1(prev)
	outstr [asciz/
/]
noats:
	IDPB	AC0,BPTR	;put an @ after the text of this word
	TLNE	BPTR,760000	;if @ is at end of word, put another @
	JRST	[IBP BPTR	;otherwise, put a zero byte
		 JRST .+2]
FINWRD:	IDPB	AC0,BPTR	;put another @ to fill up the last word
	TLNE	BPTR,760000	;now at low order byte?
	JRST	FINWRD		;no
	SUB	PREV,BPTR	;calculate the number of words in this string
	HRLM	PREV,(WD)	;store the length of this string in its LST entry
	MOVEI	PREV,100(BPTR)	;SEE IF STILL HAVE PLENTY OF TEXT SPACE
	CAMG	PREV,JOBREL↑	;NEED MORE CORE?
	JRST	FINWR1		;NO

	PUSH	P,JOBREL↑
	CORE	PREV,		;YES, GET SOME
	ERRMSG	{CANT CORE UP}
	POP	P,PREV
	SETZM	1(PREV)		;CLEAR NEW TEXT SPACE OBTAINED
	HRLI	PREV,1(PREV)
	ADDI	PREV,2
	BLT	PREV,@JOBREL↑

FINWR1:	AOBJN	WD,GETWD
	ERRMSG	{TOO MANY STRINGS.}
;Sort the strings using algorithm 5.2.2-Q in Knuth, "quicksort".

SORTEM:	TLNE	BPTR,760000
	ERRMSG	{EOF IN MIDDLE OF KEYWORD}
	MOVE	AC1,[377777777777]		;place a key of +∞ at the end
	MOVEM	AC1,1(BPTR)			;	of the list of strings

	MOVEM	BPTR,LASTCH#
	OUTSTR	[ASCIZ/SAVING STRINGS.../]
	PUSHJ	P,SAVSTR
repeat 0,<
	OUTSTR	[ASCIZ/PERVERTING.../]
	MOVSI	BPTR,010700
	HRR	BPTR,TEXTP
PERM1:	ILDB	AC1,BPTR
	MOVE	AC1,SHF1(AC1)
	DPB	AC1,BPTR
	CAME	BPTR,LASTCH
	JRST	PERM1
>;repeat 0

	MOVEI	AC1,-1
	HRLM	AC1,(WD)		;store length of the +∞ key
	HRRM	BPTR,(WD)		;store text ptr for the +∞ key
	SUBI	WD,1			;adjust the ptr to the last real key
	HRRZM	WD,RGT			;	and sort up to this key
	HRRZM	WD,LAST
	OUTSTR	[ASCIZ /SORTING.../]

Q2:	MOVE	AC1,RGT			;if RGT-LFT < MIN then use straight
	SUB	AC1,LFT			;	insertion sorting instead
	CAIGE	AC1,MIN			;	of quicksort
	JRST	Q8			;use straight insertion sorting
	MOVE	I,LFT			;I←LFT
	MOVE	J,RGT			;J←RGT
	MOVE	R,(I)			;R←R(I) (the Ith record being sorted)
	MOVE	PART1,1(R)		;load the current keyword string into
	MOVE	PART2,2(R)		;	accumulators PART1 thru PART7
	MOVE	PART3,3(R)
	MOVE	PART4,4(R)
	MOVE	PART5,5(R)
	MOVE	PART6,6(R)
	MOVE	PART7,7(R)

Q3:	HLRE	AC1,R			;get negated length of current key into AC1
	MOVE	AC2,(J)			;put the Jth record into AC2
	CAME	PART1,1(AC2)		;compare the respective parts of record R
	JRST	[CAML	PART1,1(AC2)	;	and the Jth record
		 JRST	Q4		;Jth key ≤ key of record R
		 SOJA	J,Q3]		;Jth key > key of record R
	AOJGE	AC1,Q4			;if AC1=0 then Jth key = key of record R
	CAME	PART2,2(AC2)
	JRST	[CAML	PART2,2(AC2)
		 JRST	Q4
		 SOJA	J,Q3]
	AOJGE	AC1,Q4
	CAME	PART3,3(AC2)
	JRST	[CAML	PART3,3(AC2)
		 JRST	Q4
		 SOJA	J,Q3]
	AOJGE	AC1,Q4
	CAME	PART4,4(AC2)
	JRST	[CAML	PART4,4(AC2)
		 JRST	Q4
		 SOJA	J,Q3]
	AOJGE	AC1,Q4
	CAME	PART5,5(AC2)
	JRST	[CAML	PART5,5(AC2)
		 JRST	Q4
		 SOJA	J,Q3]
	AOJGE	AC1,Q4
	CAME	PART6,6(AC2)
	JRST	[CAML	PART6,6(AC2)
		 JRST	Q4
		 SOJA	J,Q3]
	AOJGE	AC1,Q4
	CAME	PART7,7(AC2)
	JRST	[CAML	PART7,7(AC2)
		 JRST	Q4
		 SOJA	J,Q3]
;Continue sorting: Q4, Q5, Q6.

Q4:	CAMGE	I,J
	JRST	.+3			;I<J
	MOVEM	R,(I)			;I≥J.  R←Ith record.
	JRST	Q7
	MOVEM	AC2,(I)			;I<J.  Ith record ← Jth record
	ADDI	I,1			;I←I+1

Q5:	HLRE	AC1,R			;get negated length of record R into AC1
	MOVE	AC2,(I)			;get Ith record into AC2
	CAME	PART1,1(AC2)		;compare Ith key with key of record R
	JRST	[CAMG	PART1,1(AC2)
		 JRST	Q6		;key of record R ≤ Ith key
		 AOJA	I,Q5]		;key of record R > Ith key
	AOJGE	AC1,Q6			;AC1=0 means key of record R = Ith key
	CAME	PART2,2(AC2)
	JRST	[CAMG	PART2,2(AC2)
		 JRST	Q6
		 AOJA	I,Q5]
	AOJGE	AC1,Q6
	CAME	PART3,3(AC2)
	JRST	[CAMG	PART3,3(AC2)
		 JRST	Q6
		 AOJA	I,Q5]
	AOJGE	AC1,Q6
	CAME	PART4,4(AC2)
	JRST	[CAMG	PART4,4(AC2)
		 JRST	Q6
		 AOJA	I,Q5]
	AOJGE	AC1,Q6
	CAME	PART5,5(AC2)
	JRST	[CAMG	PART5,5(AC2)
		 JRST	Q6
		 AOJA	I,Q5]
	AOJGE	AC1,Q6
	CAME	PART6,6(AC2)
	JRST	[CAMG	PART6,6(AC2)
		 JRST	Q6
		 AOJA	I,Q5]
	AOJGE	AC1,Q6
	CAME	PART7,7(AC2)
	JRST	[CAMG	PART7,7(AC2)
		 JRST	Q6
		 AOJA	I,Q5]

Q6:	CAMGE	J,I
	JRST	.+3		;I<J
	MOVEM	AC2,(J)		;I≥J.  Jth record ← Ith record
	SOJA	J,Q3		;J←J-1
	MOVEM	R,(J)		;I<J.  Jth record ← record R
	MOVEM	J,I		;I←J
;Continue sorting: Q7, Q8.

;record R is now in its final place, dividing the list into two sublists.
;continue by sorting the smaller sublist next.
Q7:	MOVE	AC2,I		;AC2 ← I
	ASH	AC2,1		;AC2 ← 2*I
	SUB	AC2,LFT		;AC2 ← 2*I - LFT
	CAMLE	AC2,RGT		;is 2*I - LFT ≤ RGT ? (ie I-LFT ≤ RGT -I)
	JRST	Q7A		;no
	MOVE	AC2,I		;yes
	ADDI	AC2,1
	PUSH	P,AC2		;save (on the stack) the sublist from I+1 to RGT 
	PUSH	P,RGT
	SUBI	AC2,2
	MOVEM	AC2,RGT		;RGT ← I-1
	JRST	Q2

Q7A:	PUSH	P,LFT		;save (on the stack) the sublist from LFT to I-1
	MOVE	AC2,I
	SUBI	AC2,1
	PUSH	P,AC2
	ADDI	AC2,2
	MOVEM	AC2,LFT		;LFT ← I+1
	JRST	Q2

;prepare to sort from LFT to RGT by straight insertion
Q8:	AOS	J,LFT		;J ← LFT + 1
Q8A:	CAMLE	J,RGT		;insert record J into the sorted list unless J > RGT
	JRST	Q9		;insertion sort is finished
	MOVE	R,(J)		;record R ← Jth record
	MOVE	PART1,1(R)	;load the parts of the key of record R into ACs
	MOVE	PART2,2(R)
	MOVE	PART3,3(R)
	MOVE	PART4,4(R)
	MOVE	PART5,5(R)
	MOVE	PART6,6(R)
	MOVE	PART7,7(R)
	MOVEI	I,-1(J)		;I ← J-1
;Continue sorting: Q8B, Q8C, Q9.

;insertion sorting for small numbers of elements (continued).
Q8B:	MOVE	AC2,(I)		;put the Ith record into AC2
	HLRE	AC1,R		;get the length of the key of record R into AC1
	CAME	PART1,1(AC2)	;compare the Ith key with the key of record R
	JRST	[CAML	PART1,1(AC2)
		 JRST	Q8C		;key of record R ≥ Ith key
	   OVER: MOVE	AC1,(I)		;key of record R < Ith key.  move the Ith
		 MOVEM	AC1,1(I)	;	record over one to the right
		 SOJA	I,Q8B]		;I ← I-1.  get the new Ith record
	AOJGE	AC1,Q8C			;AC1=0 means key of record R = Ith key
	CAME	PART2,2(AC2)
	JRST	[CAML	PART2,2(AC2)
		 JRST	Q8C
		 JRST   OVER]
	AOJGE	AC1,Q8C
	CAME	PART3,3(AC2)
	JRST	[CAML	PART3,3(AC2)
		 JRST	Q8C
		 JRST   OVER]
	AOJGE	AC1,Q8C
	CAME	PART4,4(AC2)
	JRST	[CAML	PART4,4(AC2)
		 JRST	Q8C
		 JRST   OVER]
	AOJGE	AC1,Q8C
	CAME	PART5,5(AC2)
	JRST	[CAML	PART5,5(AC2)
		 JRST	Q8C
		 JRST   OVER]
	AOJGE	AC1,Q8C
	CAME	PART6,6(AC2)
	JRST	[CAML	PART6,6(AC2)
		 JRST	Q8C
		 JRST   OVER]
	AOJGE	AC1,Q8C
	CAME	PART7,7(AC2)
	JRST	[CAML	PART7,7(AC2)
		 JRST	Q8C
		 JRST   OVER]

Q8C:	MOVEM	R,1(I)		;found the place in the sorted list for record R
	AOJA	J,Q8A		;J ← J+1.  get next key to be inserted

Q9:	CAMN	P,INITP		;is the stack of empty of sublists to be sorted?
	JRST	WRITEM		;yes.  everything is sorted so write out the results
	POP	P,RGT		;no.  pop a sublist off
	POP	P,LFT		;	the stack and
	JRST	Q2		;	go sort it
;Write out sorted file: WRITEM.

WRITEM:	SETZM	COUNT		;NUMBER OF SORTED STRINGS, NOT COUNTING DUPLICATES

	OUTSTR	[ASCIZ/REVERTING.../]
	PUSHJ	P,RSTSTR	;RESTORE STRING SPACE TO ORIGINAL VALUES
REPEAT 0,<
	MOVSI	BPTR,010700
	HRR	BPTR,TEXTP
PERM2:	ILDB	AC1,BPTR	;GUESS WHAT THIS LOOP DOES!
	MOVE	AC1,SHF2(AC1)
	DPB	AC1,BPTR
	CAME	BPTR,LASTCH
	JRST	PERM2
>;END REPEAT 0

	OUTSTR	[ASCIZ /
DUPLICATES:

/]
	MOVEI	WD,LST+1	;make WD point at first element of sorted list
	MOVSI	AFTER,AC2	;SET UP INDEX FIELD OF INDIRECT PTR
	HRR	AFTER,TEXTP1	;MAKE PREVIOUS KEY BE THAT OF -∞

NEXTWD:	HRRZ	BPTR,(WD)	;set up byte ptr to text of current key
	HRLI	BPTR,700
	MOVE	BEFORE,AFTER	;save indirect ptr to text of previous key
	HRR	AFTER,BPTR	;set up indirect ptr to text of current key
	HLLZ	AC2,(WD)	;put negated length of current key in left of AC2
	ADDI	AC2,1		;put displacement of 1 into right half of AC2
CMPR:	MOVE	PART7,@AFTER	;get one part of current key and compare
	CAME	PART7,@BEFORE	;	it to corresponding part of old key
	JRST	NEXTCH		;the corresponding parts are not the same
	AOBJN	AC2,CMPR	;they are the same.  get next part of each, if any.
	JRST	DUP		;all parts of the previous and current keys were samm

NEXTC1:	PUSHJ	P,PUTCH
NEXTCH:	ILDB	CHAR,BPTR	;get a char of current key
	CAIE	CHAR,"@"	;is it a "@"?
	JRST	NEXTC1		;NO
ENDWD:	MOVEI	CHAR,CR		;output a CR and a LF after the key in
	PUSHJ	P,PUTCH		;	the file of sorted keys
	MOVEI	CHAR,LF
	PUSHJ	P,PUTCH
	AOS	COUNT		;count the number of keys (not including duplicates)

FINWD:	CAMGE	WD,LAST		;have we gotten to the last of the sorted keys?
	AOJA	WD,NEXTWD	;no.  go back and get the next one.
	RELEAS	2,		;yes.  close the output file
	RELEAS	1,		;input file
	OUTSTR	[ASCIZ /
/]
	MOVE	AC1,COUNT	;convert the number of keys to ascii
	MOVE	BPTR,[POINT 7,DIGITS]
	PUSHJ	P,NXTDG
	SETZ	AC2,
	IDPB	AC2,BPTR
	OUTSTR	DIGITS		;print out the number of keys (not including duplicates)
	OUTSTR	[ASCIZ / sorted strings./]
	EXIT
;Subroutines: GETCH, PUTWD, PUTCH, ERROR, DUP, PUTDUP, NXTDG.

;get a character from the input file.
GETCH:	SOSG	IBUF+2			;decrement byte count
	IN	1,			;buffer emptied.  get another
	JRST	[ILDB	CHAR,IBUF+1	;load a character into CHAR
		 JUMPE	CHAR,GETCH	;if the char is a null, get another char
		 CAIN	CHAR,FF		;IGNORE FORMFEEDS
		 JRST	GETCH
		 POPJ	P,]
	STATO	1,20000			;test for EOF
	ERRMSG	{UNKNOWN ERROR CONDITION CAME UP ON INPUT}
	SUB	P,[XWD 1,1]		;pop return address off the stack
	JRST	SORTEM			;go sort the keys that have been read in

;output a character to the file of sorted keys.
PUTCH:	JUMPE	CHAR,CPOPJ
	SOSG	OBUF+2			;decrement byte count
	OUT	2,			;buffer filled.  output it.
	JRST	[IDPB	CHAR,OBUF+1	;deposit a character into the output buffer
		 POPJ	P,]
	ERRMSG	{UNKNOWN ERROR CONDITION CAME UP ON OUTPUT}

;print out an error message on the tty.
ERROR:	OUTSTR	[CRLFS:	ASCIZ /

/]
	OUTSTR	(AC1)
	OUTSTR	CRLFS
	MOVE	AC1,SAVEAC
	EXIT	1,

;print out a duplicate string on the tty.
DUP:	ILDB	CHAR,BPTR
	CAIN	CHAR,"@"
	JRST	FINWD			;this is a duplicate null word
	OUTSTR	(BPTR)			;type out the keyword
	OUTSTR	[ASCIZ/
/]
	JRST	FINWD

;convert a number to ascii, depositing the ascii digits with the byte ptr BPTR
NXTDG:	IDIVI	AC1,=10		;divide the number by =10 and
	HRLM	AC2,(P)		;	save the remainder
	JUMPE	AC1,.+2		;if the quotient is zero, the conversion is done
	PUSHJ	P,NXTDG		;otherwise, calculate the next digit
	HLRZ	AC1,(P)		;get high order digits off stack first
	ADDI	AC1,60		;convert current digit to ascii
	IDPB	AC1,BPTR	;deposit it in ascii string
CPOPJ:	POPJ	P,		;get next digit, or return if all done
;GETFIL	NOLOOK	NOENTR	FERROR

F←0
PPN←←BEFORE
CH←←CHAR
BP←←BPTR
A←←AC1
C←←AC2

;FLAGS IN LEFT HALF OF F
QUOTE←←400000
GOTEXT←←200000
GOTP←←100000
GOTPN←←40000

GETFIL:	MOVEI	I,6		;limit filename to 6 chars
	MOVE	BP,[POINT 6,(R)]
	SETZB	F,(R)
	SETZB	PPN,1(R)
	JRST	TEST

DOQUOT:	TLC	F,QUOTE
	JRST	TEST
GETNAM:	TRZ	CH,40		;convert char to sixbit
	TRZE	CH,100
	TRO	CH,40
	SOJL	I,.+2
	IDPB	CH,BP
TEST:	INCHWL	CH
	CAIN	CH,CR		;END OF INPUT?
	JRST	ENDNAM		;YES
	CAIN	CH,"↓"
	JRST	DOQUOT
	TLNE	F,QUOTE		;ARE WE QUOTING A NAME?
	JRST	GETNAM		;YES, DONT MAKE SPECIAL TESTS
	CAIN	CH,"]"		;END OF P,PN?
	JRST	ENDNAM		;YES TO ONE OF THESE
	CAIN	CH,"["		;PROJECT NEXT?
	JRST	GETP		;YES
	CAIN	CH,","		;PROGRAMMER NAME NEXT?
	JRST	GETPN		;YES
	CAIE	CH,"."		;EXTENSION NEXT?
	JRST	GETNAM		;NO
GETEXT:	TLOE	F,GOTEXT	;MAKE SURE WE DONT ALREADY HAVE AN EXTENSION
	POPJ	P,		;TAKE ERROR RETURN
	MOVE	BP,[POINT 6,1(R)]
GOON:	MOVEI	I,3
	JRST	TEST
GETP:	TLOE	F,GOTP		;MAKE SURE WE DONT ALREADY HAVE A PROJECT
	POPJ	P,		;TAKE ERROR RETURN
	MOVE	BP,[POINT 6,PPN]	;PUT PROJECT INTO LEFT HALF OF PPN
	JRST	GOON
GETPN:	TLON	F,GOTPN		;MAKE SURE WE DONT ALREADY HAVE A PROGRAMMER NAME
	TLNN	F,GOTP		;MAKE SURE WE DO HAVE A PROJECT
	POPJ	P,		;TAKE ERROR RETURN
	SETZ	C,
	MOVE	BP,[POINT 6,C,17]	;PUT PROGRAMMER NAME INTO RIGHT HALF OF C
	JUMPLE	I,GOON
	LSH	PPN,-6		;RIGHT-JUSTIFY PROJECT IN LEFT HALF OF PPN
	SOJG	I,.-1
	JRST	GOON
ENDNAM:	INCHRW	CHAR
	CAIE	CHAR,LF			;FORGET INPUT AFTER "]" OR CR UP TO LF
	JRST	ENDNAM
	TLNN	F,GOTP				;PROJECT SPECIFIED?
	JRST	END1				;NO
	TLNN	F,GOTPN				;PROGRAMMER NAME?
	JRST	END2				;NO
	JUMPLE	I,END4				;YES.  ALREADY RIGHT JUSTIFIED?
	LSH	C,-6				;NO.  DO IT NOW.
	SOJG	I,.-1
	JRST	END4
END2:	JUMPLE	I,END5				;PROJECT RIGHT JUSTIFIED?
	LSH	PPN,-6				;NO.  DO IT NOW.
	SOJG	I,.-1
END5:	SETZ	C,				;GET OWN DISK PPN
	DSKPPN	C,
END4:	HRR	PPN,C				;COMBINE P & PN IN PPN
END1:	MOVEM	PPN,-1(R)			;SAVE PPN
	AOS	(P)
	POPJ	P,

NOLOOK:	OUTSTR	[ASCIZ/LOOKUP FAILED -- /]
	HRRZ	A,INFILE+1		;GET ERROR CODE
	CAILE	A,MAXERR
	MOVEI	A,MAXERR
	OUTSTR	@FERROR(A)
	OUTSTR	[ASCIZ/.

/]
	JRST	GETIN

NOENTR:	OUTSTR	[ASCIZ/ENTER FAILED -- /]
	HRRZ	A,OUTFIL+1		;GET ERROR CODE
	CAILE	A,MAXERR
	MOVEI	A,MAXERR
	OUTSTR	@FERROR(A)
	OUTSTR	[ASCIZ/.

/]
	JRST	GETOUT

FERROR:	[ASCIZ/NO SUCH FILE/]
	[ASCIZ/ILLEGAL PPN/]
	[ASCIZ/PROTECTION VIOLATION/]
	[ASCIZ/FILE BUSY/]
MAXERR←←.-FERROR
	[ASCIZ/BAD RETRIEVAL OR OTHER HORRIBLE ERROR/]
;SAVSTR	RSTSTR

STRCMD:	0	;DUMP MODE COMMAND FOR SAVING/RESTORING STRING SPACE GOES HERE
	0

SAVSTR:	INIT	3,17
	SIXBIT	/DSK/
	0
	ERRMSG	{CANT INIT DSK}
	PUSH	P,PART1
	PUSH	P,PART2
	PUSH	P,PART3
	PUSH	P,PART4
	ACCTIM	PART1,
	MOVEM	PART1,STRFIL#
	MOVSI	PART2,'ZXC'
	SETZB	PART3,PART4
	ENTER	3,PART1
	ERRMSG	{CANT ENTER TEMPORARY STRING FILE}
	MOVE	PART1,TEXTP
	MOVEM	PART1,STRCMD
	HRRZ	PART2,LASTCH
	SUBI	PART1,2(PART2)
	HRLM	PART1,STRCMD	;STORE LENGTH FIELD IN DUMP MODE COMMAND
	OUT	3,STRCMD
	JRST	.+2
	ERRMSG	{OUT FAILED WHEN WRITING TEMPORARY STRING FILE}
	CLOSE	3,
	POP	P,PART4
	POP	P,PART3
	POP	P,PART2
	POP	P,PART1
	POPJ	P,

RSTSTR:	
	PUSH	P,PART1
	PUSH	P,PART2
	PUSH	P,PART3
	PUSH	P,PART4
	MOVE	PART1,STRFIL	;PICK UP NAME OF TEMP FILE
	MOVSI	PART2,'ZXC'	;AND EXTENSION
	SETZ	PART4,
	LOOKUP	3,PART1
	ERRMSG	{LOOKUP FAILED FOR TEMPORARY STRING FILE}
	IN	3,STRCMD
	JRST	.+2
	ERRMSG	{IN FAILED WHEN READING TEMPORARY STRING FILE}
	CLOSE	3,
	SETZB	PART1,PART4
	RENAME	3,PART1		;DELETE TEMP FILE
	OUTSTR	[ASCIZ/Failed to delete temporary string file.
/]
	RELEAS	3,
	POP	P,PART4
	POP	P,PART3
	POP	P,PART2
	POP	P,PART1
	POPJ	P,

	END	SORT